home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / eulisp / mpfeel.lha / MPFeel / Modules / loops-broke.em < prev    next >
Lisp/Scheme  |  1992-10-06  |  1KB  |  63 lines
  1. ; tail recursive loops
  2. ; uses dynamic (in catch/throw) and multiple values
  3.  
  4. (defmodule loops
  5.  
  6.   (standard) ()
  7.  
  8.   ()
  9.  
  10.   (defun map-while (ff pf val)
  11.     (multiple-value-bind
  12.      (ans cont)
  13.      (catch @cc@ (map-while-cont ff pf val))
  14.      (if cont
  15.      (map-while ff pf val)
  16.          ans)))
  17.  
  18.   (defun map-while-cont (ff pf val)
  19.     (if (pf)
  20.     (map-while-cont ff pf (ff))
  21.         (values val ())))
  22.  
  23.   (defmacro break forms
  24.     `(throw @bc@ (progn ,@forms)))
  25.  
  26.   (defmacro continue ()
  27.     `(throw @cc@ (values () t)))
  28.  
  29.   (defmacro while (pred . forms)
  30.     `(catch @bc@
  31.        (map-while (lambda () ,@forms)
  32.           (lambda () ,pred)
  33.           ())))
  34.  
  35.   (defmacro for (init test iter . body)
  36.     `(progn
  37.        ,init
  38.        (catch @bc@
  39.       (map-for (lambda () ,@body)
  40.            (lambda () ,test)
  41.            (lambda () ,iter)
  42.            ()))))
  43.  
  44.   (defun map-for (ff pf itf val)
  45.     (if (pf)
  46.     (multiple-value-bind
  47.       (ans cont)
  48.       (catch @cc@ (map-for-cont ff pf itf (ff)))
  49.       (if cont
  50.           (progn (itf) (map-for ff pf itf val))
  51.           ans))
  52.         val))
  53.  
  54.   (defun map-for-cont (ff pf itf val)
  55.     (itf)
  56.     (if (pf)
  57.     (map-for-cont ff pf itf (ff))
  58.         (values val ())))
  59.  
  60.   (export map-while while map-for for break continue)
  61.  
  62. )
  63.